home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr48 / tttsrc51.zip / LISTTTT5.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  18KB  |  496 lines
  1. {--------------------------------------------------------------------------}
  2. {                         TechnoJock's Turbo Toolkit                       }
  3. {                                                                          }
  4. {                              Version   5.10                              }
  5. {                                                                          }
  6. {                                                                          }
  7. {               Copyright 1986-1993 TechnoJock Software, Inc.              }
  8. {                           All Rights Reserved                            }
  9. {                          Restricted by License                           }
  10. {--------------------------------------------------------------------------}
  11.  
  12.                      {--------------------------------}
  13.                      {       Unit:  ListTTT5          }
  14.                      {--------------------------------}
  15.  
  16.  
  17. {Update History:     5.01a   Removed refrences to VER50 and added DEBUG
  18.                              compiler directive, added Mouse enter
  19.                      5.01b   Added first character highlight selection
  20.                      5.02a   Move TopPick and HiPick to globals
  21.           01/04/93   5.10   DPMI compatible version
  22. }
  23.  
  24. {$S-,R-,V-}
  25. {$IFNDEF DEBUG}
  26. {$D-}
  27. {$ENDIF}
  28.  
  29. Unit ListTTT5;
  30.  
  31. interface
  32.  
  33. Uses CRT, DOS, FastTTT5, WinTTT5, KeyTTT5, StrnTTT5;
  34.  
  35. const
  36.      Max_Topics = 255;
  37.  
  38. Type
  39.    Choices = array[1..Max_Topics] of boolean;
  40.    {$IFNDEF VER40}
  41.     List_Hook = Procedure(var Ch: char; HiPick:byte);
  42.    {$ENDIF}
  43.    L_Display = record
  44.                      X           : byte;             {top X coord}
  45.                      Y           : byte;             {top Y coord}
  46.                      LeftSide    : Boolean;          {X,Y is leftside of box}
  47.                      Lines       : byte;             {max no of lines to display in box}
  48.                      TopicWidth  : byte;             {width of the slection bar}
  49.                      AllowEsc    : boolean;          {allow the user to escape?}
  50.                      BoxType     : byte;             {single,double etc}
  51.                      BoxFCol     : byte;             {Border foreground color}
  52.                      BoxBCol     : byte;             {Border background color}
  53.                      CapFCol     : byte;             {Capital letter foreground color}
  54.                      BacCol      : byte;             {menu background color}
  55.                      NorFCol     : byte;             {normal foreground color}
  56.                      HiFCol      : byte;             {highlighted topic foreground color}
  57.                      HiBCol      : byte;             {highlighted topic background color}
  58.                      LeftChar    : char;             {left-hand topic highlight character}
  59.                      RightChar   : char;             {right-hand topic highlight character}
  60.                      ToggleChar  : char;             {indicates if a topic has been selected}
  61.                      AllowToggle : Boolean;          {can user select more than one topic}
  62.                      End_Chars   : set of char;      {end of input chars}
  63.                      Select_Chars: set of char;      {keys for user to select topic}
  64.                      {$IFNDEF VER40}
  65.                      Hook: List_Hook; {a procedure called after every key is pressed}
  66.                      {$ENDIF}
  67.                end;
  68.  
  69. Var
  70.    LTTT    : L_Display;
  71.    L_Picks : Choices;
  72.    L_Char  : Char;
  73.    L_Pick  : Byte;
  74.    TopPick     : byte;
  75.    HiPick      : byte;
  76.    {$IFDEF VER40}
  77.    L_UserHook  : pointer;
  78.    {$ENDIF}
  79.  
  80. Procedure Default_Settings;
  81. Procedure Show_List(var StrArray;StrLength:Byte;TotalPicks:byte);
  82. Procedure New_Show_List(var StrArray;StrLength:Byte;TotalPicks:byte);
  83.  
  84. IMPLEMENTATION
  85. const
  86.     Default_Display_Lines = 10;
  87.     Default_Y1            = 7;
  88.  
  89.   {$IFNDEF VER40}
  90.   {$F+}
  91.   Procedure No_Hook(var Ch: char; HiPick :byte);
  92.   {}
  93.   begin
  94.   end; {of proc No_Hook}
  95.   {$F-}
  96.   {$ENDIF}
  97.  
  98.   Procedure Default_Settings;
  99.   begin
  100.       with LTTT do
  101.       begin
  102.           AlloWEsc := true;
  103.           X := 0;
  104.           Y := 0;
  105.           LeftSide := true;
  106.           BoxType      := 1;
  107.           Lines := 0;
  108.           TopicWidth   := 0;
  109.           If ColorScreen then
  110.           begin
  111.               BoxFCol      := yellow;
  112.               BoxBCol      := blue;
  113.               CapFCol      := White;
  114.               BacCol       := blue;
  115.               NorFCol      := lightgray;
  116.               HiFCol       := white;
  117.               HiBCol       := red;
  118.           end
  119.           else
  120.           begin
  121.               BoxFCol      := white;
  122.               BoxBCol      := black;
  123.               CapFCol      := White;
  124.               BacCol       := black;
  125.               NorFCol      := lightgray;
  126.               HiFCol       := white;
  127.               HiBCol       := black;
  128.           end;
  129.           LeftChar     := Chr(16);
  130.           RightChar    := Chr(17);
  131.           ToggleChar   := Chr(251);
  132.           AllowToggle  := true;
  133.           End_Chars    := [#13,#133];
  134.           Select_Chars := [' '];
  135.           {$IFNDEF VER40}
  136.           Hook := No_Hook;
  137.           {$ELSE}
  138.           L_UserHook := nil;
  139.           {$ENDIF}
  140.       end;  {with}
  141.       TopPick := 1;
  142.       HiPick := 1;
  143.   end;  {Default_Settings}
  144.  
  145.   {$IFDEF VER40}
  146.    Procedure CallFromListUserHook(var Ch:char;Hipick:byte);
  147.              Inline($FF/$1E/L_UserHook);
  148.   {$ENDIF}
  149.  
  150.  Procedure New_Show_List(var StrArray;StrLength:Byte;TotalPicks:byte);
  151.  {}
  152.  var
  153.    X1,Y1,X2,Y2 : byte;
  154.    ListWidth   : byte;
  155.    ListLines   : byte;
  156. (*
  157.    TopPick     : byte;
  158.    HiPick      : byte;
  159. *)
  160.    Selected    : Choices;
  161.    Finished    : boolean;
  162.    Scrolling   : boolean;
  163.    ChL         : char;
  164.  
  165.          Function TopicStr(StrNo:byte): StrScreen;
  166.          {searches through string array and returns the string}
  167.          var
  168.            W : word;
  169.            TempStr : String;
  170.            ArrayOffset: word;
  171.          begin
  172.              W := pred(StrNo) * succ(StrLength);
  173.              ArrayOffset := Ofs(StrArray) + W;
  174.              Move(Mem[Seg(StrArray):ArrayOffset],TempStr,1);            {string length in byte 0}
  175.              Move(Mem[Seg(StrArray):succ(ArrayOffset)],TempStr[1],ord(TempStr[0]));
  176.              TopicStr := TempStr;
  177.          end; {of func TopicStr}
  178.  
  179.          Procedure Write_Topic(TopicNo:word;Hilight:boolean);
  180.          {}
  181.          var
  182.            A, Y : byte;
  183.            Tick : char;
  184.          begin
  185.              Y := Succ(Y1) + TopicNo - TopPick;
  186.              If Selected[TopicNo] then
  187.                 Tick := LTTT.ToggleChar
  188.              else
  189.                 Tick := ' ';
  190.              If HiLight then
  191.                 Fastwrite(succ(X1),Y,
  192.                           attr(LTTT.HiFCol,LTTT.HiBCol),
  193.                           LTTT.LeftChar+Tick+' '+padleft(TopicStr(TopicNo),ListWidth,' ')+LTTT.RightChar)
  194.              else
  195.              begin
  196.                 Fastwrite(succ(X1),Y,
  197.                           attr(LTTT.NorFCol,LTTT.BacCol),
  198.                           ' '+Tick+' '+padleft(TopicStr(TopicNo),ListWidth,' ')+' ');
  199.                 A := First_Capital_Pos(TopicStr(TopicNo));
  200.                 If A > 0 then
  201.                    Fastwrite(X1+3+A,Y,attr(LTTT.CapFCol,LTTT.BacCol),copy(TopicStr(TopicNo),A,1));
  202.              end;
  203.          end; {of proc Write_Topic}
  204.  
  205.          Procedure Compute_Topic_Width;
  206.          {}
  207.          var
  208.            I : word;
  209.            W : Byte;
  210.          begin
  211.              ListWidth := 0;
  212.              For I := 1 To TotalPicks do
  213.              begin
  214.                  W := length(TopicStr(I));
  215.                  If ListWidth < W then
  216.                     ListWidth := W;
  217.              end;
  218.              Inc(ListWidth);  {add one char space to right}
  219.          end; {of proc Compute_Topic_Width}
  220.  
  221.          Procedure Compute_Coords;
  222.          {determines the X Y coords of the list box}
  223.          begin
  224.              With LTTT do
  225.              begin
  226.                  If TopicWidth <> 0 then
  227.                     ListWidth := TopicWidth
  228.                  else
  229.                     Compute_Topic_Width;
  230.                  ListWidth := ListWidth + 6;
  231.                  If Lines <> 0 then
  232.                     ListLines := Lines
  233.                  else
  234.                     ListLines := Default_Display_Lines;
  235.                  If ListLines > TotalPicks then
  236.                     ListLines := TotalPicks;
  237.                  If X <> 0 then
  238.                  begin
  239.                      If LeftSide then
  240.                      begin
  241.                          X1 := X;
  242.                          X2 := X1 + Pred(ListWidth);
  243.                      end
  244.                      else
  245.                      begin
  246.                          X2 := X;
  247.                          X1 := X2 - pred(ListWidth);
  248.                      end;
  249.                  end
  250.                  else
  251.                  begin
  252.                      X1 :=  (80 - ListWidth) div 2;
  253.                      X2 :=   X1 + Pred(ListWidth);
  254.                  end;
  255.                  If Y <> 0 then
  256.                      Y1 := Y
  257.                  else
  258.                      Y1 := Default_Y1;
  259.                  If Y1 + succ(ListLines) > DisplayLines then
  260.                  begin
  261.                      Y2 := DisplayLines;
  262.                      ListLines := Y2 - succ(Y1);
  263.                  end
  264.                  else
  265.                      Y2 :=  Y1 + Succ(ListLines);
  266.                  ListWidth := ListWidth - 6;    {set to actual topic width}
  267.                  If ListLines < TotalPicks then
  268.                     Scrolling := true
  269.                  else
  270.                     Scrolling := false;
  271.              end;  {with LTTT}
  272.          end; {of proc Compute_Coords}
  273.  
  274.          Procedure Draw_List_Box;
  275.          {}
  276.          begin
  277.              with LTTT do
  278.              begin
  279.                  Box(X1,Y1,X2,Y2,BoxFCol,BoxBCol,BoxType);
  280.                  ClearText(succ(X1),Succ(Y1),Pred(X2),Pred(Y2),NorFcol,BacCol);
  281.              end; {with}
  282.          end; {of proc Draw_List_Box}
  283.  
  284.          Procedure Set_Parameters;
  285.          {}
  286.          var I : integer;
  287.          begin
  288.              For I := 1 to Max_Topics do
  289.                  Selected[I] := false;
  290.          (*
  291.              TopPick := 1;
  292.              HiPick := 1;
  293.          *)
  294.          end; {of proc Set_Parameters}
  295.  
  296.          Procedure Display_More;
  297.          {}
  298.          var A : byte;
  299.          begin
  300.              If Scrolling then
  301.              begin
  302.                     A := attr(LTTT.BoxFCol,LTTT.BoxBCol);
  303.                     If TopPick > 1 then
  304.                        Fastwrite(X2,Succ(Y1),A,chr(24))
  305.                     else
  306.                        VertLine(X2,Succ(Y1),Succ(Y1),LTTT.BoxFcol,LTTT.BoxBCol,Lttt.Boxtype);
  307.                     If TopPick + Pred(ListLines) < TotalPicks then
  308.                        Fastwrite(X2,Pred(Y2),A,chr(25))
  309.                     else
  310.                        VertLine(X2,Pred(Y2),Pred(Y2),LTTT.BoxFcol,LTTT.BoxBCol,Lttt.Boxtype);
  311.              end;
  312.          end; {of proc Display_More}
  313.  
  314.          Procedure Display_All_Topics;
  315.          {}
  316.          var  I : Integer;
  317.          begin
  318.              For I := TopPick to TopPick+pred(ListLines) do
  319.                  Write_Topic(I,false);
  320.              Write_Topic(HiPick,True);
  321.              Display_More;
  322.          end; {of proc Display_All_Topics}
  323.  
  324.          Procedure Find_Capital_Letter(Ch : char);
  325.          {Goes down the list to the bottom and then searches down from top}
  326.          var
  327.            I : integer;
  328.          begin
  329.              I := HiPick;
  330.              Repeat
  331.                   If I < TotalPicks then
  332.                      inc(I)
  333.                   else
  334.                      I := 1;
  335.                   If I = HiPick then exit;
  336.              Until  (First_Capital(TopicStr(I)) = Ch);
  337.              If (I >= TopPick) and (I <= TopPick + Pred(ListLines)) then
  338.              begin
  339.                  Write_Topic(HiPick,False);
  340.                  HiPick := I;
  341.                  Write_Topic(HiPick,true);
  342.              end
  343.              else
  344.              begin
  345.                  HiPick := I;
  346.                  If HiPick + pred(ListLines) > TotalPicks then
  347.                     TopPick := TotalPicks - pred(ListLines)
  348.                  else
  349.                     TopPick := HiPick;
  350.                  Display_All_Topics;
  351.              end;
  352.          end;
  353.  
  354.  begin
  355.      Set_Parameters;
  356.      Compute_Coords;
  357.      Draw_List_Box;
  358.      Display_All_Topics;
  359.      Finished := false;
  360.      Repeat
  361.           ChL := GetKey;
  362.           {$IFNDEF VER40}
  363.           LTTT.Hook(ChL,HiPick);
  364.           {$ELSE}
  365.           If L_UserHook <> nil then
  366.              CallFromListUserHook(ChL,HiPick);
  367.           {$ENDIF}
  368.           If ChL in LTTT.End_Chars then
  369.              Finished := true
  370.           else
  371.               If ChL <> #0 then
  372.               If (ChL in LTTT.Select_Chars) and LTTT.AllowToggle then
  373.               begin
  374.                    Selected[HiPick] := not Selected[HiPick];
  375.                    Write_Topic(HiPick,True);
  376.               end
  377.               else
  378.                  Case UpCase(ChL) of
  379.                  #132,
  380.                  #027: If LTTT.AllowEsc then       {Esc}
  381.                           Finished := True;
  382.                  #129,                             {Mouse_Down}
  383.                  #208: begin                       {Down_Arrow}
  384.                            Write_Topic(HiPick,False);
  385.                            If HiPick < TotalPicks then
  386.                               Inc(HiPick)
  387.                            else
  388.                               If (Scrolling = false) and (Chl <> #129) then
  389.                                  HiPick := 1;
  390.                            If HiPick > TopPick + Pred(ListLines) then
  391.                            begin
  392.                                Inc(TopPick);
  393.                                Display_All_Topics;
  394.                            end
  395.                            else
  396.                               Write_Topic(HiPick,True);
  397.                        end;
  398.                  #128,                             {Mouse_Up}
  399.                  #200: begin                       {Up_Arrow}
  400.                            Write_Topic(HiPick,False);
  401.                            If HiPick > 1 then
  402.                               Dec(HiPick)
  403.                            else
  404.                               If (Scrolling = false) and (Chl <> #128) then
  405.                                  HiPick := TotalPicks;
  406.                            If HiPick < TopPick then
  407.                            begin
  408.                                Dec(TopPick);
  409.                                Display_All_Topics;
  410.                            end
  411.                            else
  412.                               Write_Topic(HiPick,True);
  413.                        end;
  414.                  #199: If HiPick <> 1 then       {Home}
  415.                        begin
  416.                            HiPick := 1;
  417.                            TopPick := 1;
  418.                            Display_All_Topics;
  419.                        end;
  420.                  #207: If HiPick <> TotalPicks then   {end}
  421.                        begin
  422.                            HiPick := TotalPicks;
  423.                            TopPick := HiPick - pred(ListLines);
  424.                            Display_All_Topics;
  425.                        end;
  426.                  #201: If Scrolling then   {PgUp}
  427.                        begin
  428.                           If HiPick > ListLines then
  429.                           begin
  430.                              HiPick := HiPick - ListLines;
  431.                              If TopPick > ListLines then
  432.                                 TopPick := TopPick - ListLines
  433.                              else
  434.                                 TopPick := 1;
  435.                           end
  436.                           else
  437.                           begin
  438.                              HiPick := 1;
  439.                              TopPick := 1;
  440.                           end;
  441.                           Display_All_Topics;
  442.                       end
  443.                       else
  444.                       begin
  445.                           If HiPick > 1 then
  446.                           begin
  447.                               Write_Topic(HiPick,False);
  448.                               HiPick := 1;
  449.                               Write_Topic(HiPick,True);
  450.                           end;
  451.                       end;
  452.                  #209:If Scrolling then   {PgDn}
  453.                       begin
  454.                           If HiPick + ListLines <= TotalPicks then
  455.                           begin
  456.                              HiPick := HiPick + ListLines;
  457.                              If TopPick + ListLines +pred(ListLines) > TotalPicks then
  458.                                 TopPick := TotalPicks - pred(ListLines)
  459.                              else
  460.                                 TopPick := TopPick + ListLines;
  461.                           end
  462.                           else
  463.                           begin
  464.                              HiPick := TotalPicks;
  465.                              TopPick := TotalPicks - pred(ListLines);
  466.                           end;
  467.                           Display_All_Topics;
  468.                       end
  469.                       else
  470.                       begin
  471.                           If HiPick < TotalPicks then
  472.                           begin
  473.                               Write_Topic(HiPick,False);
  474.                               HiPick := TotalPicks;
  475.                               Write_Topic(HiPick,True);
  476.                           end;
  477.                       end;
  478.                  'A'..'Z' : Find_Capital_Letter(upcase(ChL));
  479.                  end;  {case}
  480.      Until Finished;
  481.      L_Char := ChL;
  482.      L_Picks := Selected;
  483.      L_Pick := HiPick;
  484.  end; {of proc New_Show_List}
  485.  
  486.  Procedure Show_List(var StrArray;StrLength:Byte;TotalPicks:byte);
  487.  begin
  488.     TopPick := 1;
  489.     HiPick := 1;
  490.     New_Show_List(StrArray,StrLength,TotalPicks);
  491.  end; {Show_List}
  492.  
  493. begin
  494.     Default_Settings;
  495. end.
  496.